'  ==========================================================================
'  |                                                                        |
'  | SQLitening Server Admin                                                |
'  |                                                                        |
'  ==========================================================================
'  Admin the SQLitening Server Service.  Will do the following:
'     -- Install the service.
'     -- Start the service.
'     -- Stop the service.
'     -- Uninstall the service.
'     -- Refresh the FACT.
'     -- List active connections.
'     -- Kill an active connection.
'  This program can run in Quiet mode by passing the Q command line parm.
'  The Q must be proceeded with a / or - (OS standard).  The Q must be followed
'  by a numerical value for the action requested as follows:
'      1 = Install
'      2 = Start --- will first Install if required
'      4 = Stop
'      8 = Uninstall --- will first Stop if required
'     16 = Reload Config
'  This program will return the following process exit codes if in Quiet mode:
'     0 = All OK
'     1 = Can't perform request, service in wrong status
'     2 = Request failed.
'     9 = Service in unknown or invalid status

'
'  ==========================================================================
'  PUBLIC DOMAIN SOFTWARE
'  The author or authors of this code dedicate any and all
'  copyright interest in this code to the public domain.
'  Anyone is free to copy, modify, publish, use, compile,
'  sell, or distribute the original code, either in source
'  code form or as a compiled binary, for any purpose,
'  commercial or non-commercial, and by any means.
'  Fred Meier - July 2010
'  ==========================================================================

'#Compile Exe "..\Bin\SQLiteningServerAdmin.Exe"
#Compile Exe "..\Bin\slSQLAdmin.Exe"
#Dim All
#Resource "SQLitening.Pbr"

'============================<[ Equates ]>=============================
' ==========>>> Controls
%rbRefreshConfig     = 301
%rbListConnections   = 302
%rbKillConnection    = 303
%butRun              = 102
%butExit             = 2

' ==========>>> MessageBox Flags
%MB_OKCancel                  = &H00000001&
%MB_AbortRetryIgnore          = &H00000002&
%MB_YesNoCancel               = &H00000003&
%MB_YesNo                     = &H00000004&
%MB_RetryCancel               = &H00000005&
%MB_CancelTryContinue         = &H00000006&
%MB_IconStop                  = &H00000010&
%MB_IconQuestion              = &H00000020&
%MB_IconExclamation           = &H00000030&
%MB_IconInformation           = &H00000040&
%MB_DefButton2                = &H00000100&
%MB_DefButton3                = &H00000200&

' ==========>>> Misc
'$ServiceProgramAndParm = "SQLiteningServer.Exe" & " " & chr$(&HFF)
$ServiceProgramAndParm = "slSQLServer.exe" & " " & Chr$(&HFF) 
%Null = 0
%reqAdmin = 23
%True = -1
%HCBT_ACTIVATE = 5
%DM_SETDEFID = %WM_USER + 1
%WH_CBT = 5
%MB_IDAbort    = 3
%MB_IDRetry    = 4
%MB_IDIgnore   = 5
%MB_IDYes      = 6
%MB_IDNo       = 7
%MB_IDOK       = 1

'============================<[ Declares ]>============================
Declare Function SetWindowsHookEx LIB "USER32.DLL" ALIAS "SetWindowsHookExA" (BYVAL idHook AS LONG, BYVAL lpfn AS DWORD, BYVAL hMod AS DWORD, BYVAL dwThreadId AS DWORD) AS LONG
Declare Function UnhookWindowsHookEx LIB "USER32.DLL" ALIAS "UnhookWindowsHookEx" (BYVAL hHook AS DWORD) AS LONG
Declare Function GetCurrentThreadId LIB "KERNEL32.DLL" ALIAS "GetCurrentThreadId" () AS Long
Declare Function MessageBox LIB "USER32.DLL" ALIAS "MessageBoxA" (BYVAL hWnd AS DWORD, lpText AS ASCIIZ, lpCaption AS ASCIIZ, BYVAL dwType AS DWORD) AS LONG
Declare Function GetModuleFileName LIB "KERNEL32.DLL" ALIAS "GetModuleFileNameA" (BYVAL hModule AS DWORD, lpFileName AS ASCIIZ, BYVAL nSize AS DWORD) AS DWORD
Declare Function GetModuleHandle LIB "KERNEL32.DLL" Alias "GetModuleHandleA" (lpModuleName as Asciz) as Dword
Declare Function GetPrivateProfileString LIB "KERNEL32.DLL" ALIAS "GetPrivateProfileStringA" (lpApplicationName AS ASCIIZ, lpKeyName AS ASCIIZ, lpDefault AS ASCIIZ, lpReturnedString AS ASCIIZ, BYVAL nSize AS DWORD, lpFileName AS ASCIIZ) AS DWORD
Declare Function ZLibUnCompress Lib "ZLib.dll" Alias "uncompress"(uncompr As Any, uncomprLen As Dword, compr As Any, byval lcompr As Dword)As Long

'===========<[ Equates, Types, and Declares for Services ]>============
%SC_MANAGER_CONNECT            = &H1
%SC_MANAGER_CREATE_SERVICE     = &H2
%SERVICE_QUERY_CONFIG          = &H1
%SERVICE_CHANGE_CONFIG         = &H2
%SERVICE_QUERY_STATUS          = &H4
%SERVICE_ENUMERATE_DEPENDENTS  = &H8
%SERVICE_START                 = &H10
%SERVICE_STOP                  = &H20
%SERVICE_PAUSE_CONTINUE        = &H40
%SERVICE_INTERROGATE           = &H80
%SERVICE_USER_DEFINED_CONTROL  = &H100
%STANDARD_RIGHTS_REQUIRED = &H000F0000
%SERVICE_ALL_ACCESS = %STANDARD_RIGHTS_REQUIRED OR %SERVICE_QUERY_CONFIG OR %SERVICE_CHANGE_CONFIG OR %SERVICE_QUERY_STATUS _
                    OR %SERVICE_ENUMERATE_DEPENDENTS OR %SERVICE_START OR %SERVICE_STOP OR %SERVICE_PAUSE_CONTINUE OR %SERVICE_INTERROGATE OR %SERVICE_USER_DEFINED_CONTROL
%SERVICE_WIN32_OWN_PROCESS    = &H00000010
%SERVICE_AUTO_START     = &H00000002
%SERVICE_ERROR_NORMAL   = &H00000001

TYPE SERVICE_STATUS
  dwServiceType AS DWORD
  dwCurrentState AS DWORD
  dwControlsAccepted AS DWORD
  dwWin32ExitCode AS DWORD
  dwServiceSpecificExitCode AS DWORD
  dwCheckPoint AS DWORD
  dwWaitHint AS DWORD
END TYPE

TYPE QUERY_SERVICE_CONFIG
  dwServiceType AS DWORD
  dwStartType AS DWORD
  dwErrorControl AS DWORD
  lpBinaryPathName AS ASCIIZ PTR
  lpLoadOrderGroup AS ASCIIZ PTR
  dwTagId AS DWORD
  lpDependencies AS ASCIIZ PTR
  lpServiceStartName AS ASCIIZ PTR
  lpDisplayName AS ASCIIZ PTR
END TYPE

type QueryServiceConfig_TYPE
   QUERY_SERVICE_CONFIG
   ExtraBuffer As String * 1024
End Type

' Service State -- for CurrentState
%SERVICE_CONTROL_STOP     = &H00000001

Declare Function OpenSCManager LIB "ADVAPI32.DLL" ALIAS "OpenSCManagerA" (lpMachineName AS ASCIIZ, lpDatabaseName AS ASCIIZ, BYVAL dwDesiredAccess AS DWORD) AS LONG
Declare Function CreateService LIB "ADVAPI32.DLL" ALIAS "CreateServiceA" (BYVAL hSCManager AS DWORD, lpServiceName AS ASCIIZ, lpDisplayName AS ASCIIZ, BYVAL dwDesiredAccess AS DWORD, BYVAL dwServiceType AS DWORD, _
                 BYVAL dwStartType AS DWORD, BYVAL dwErrorControl AS DWORD, lpBinaryPathName AS ASCIIZ, lpLoadOrderGroup AS ASCIIZ, lpdwTagId AS DWORD, lpDependencies AS ASCIIZ, lp AS ASCIIZ, lpPassword AS ASCIIZ) AS LONG
Declare Function CloseServiceHandle LIB "ADVAPI32.DLL" ALIAS "CloseServiceHandle" (BYVAL hSCObject AS DWORD) AS LONG
Declare Function StartServiceA LIB "ADVAPI32.DLL" ALIAS "StartServiceA" (BYVAL hService AS DWORD, BYVAL dwNumServiceArgs AS DWORD, BYVAL lpServiceArgVectors AS LONG) AS LONG
Declare Function QueryServiceStatus LIB "ADVAPI32.DLL" ALIAS "QueryServiceStatus" (BYVAL hService AS DWORD, lpServiceStatus AS SERVICE_STATUS) AS LONG
Declare Function QueryServiceConfig LIB "ADVAPI32.DLL" ALIAS "QueryServiceConfigA" (BYVAL hService AS DWORD, lpServiceConfig AS QueryServiceConfig_TYPE, BYVAL cbBufSize AS DWORD, pcbBytesNeeded AS DWORD) AS LONG
Declare Function OpenService LIB "ADVAPI32.DLL" ALIAS "OpenServiceA" (BYVAL hSCManager AS DWORD, lpServiceName AS ASCIIZ, BYVAL dwDesiredAccess AS DWORD) AS LONG
Declare Function DeleteService LIB "ADVAPI32.DLL" ALIAS "DeleteService" (BYVAL hService AS DWORD) AS LONG
Declare Function ControlService LIB "ADVAPI32.DLL" ALIAS "ControlService" (BYVAL hService AS DWORD, BYVAL dwControl AS DWORD, lpServiceStatus AS SERVICE_STATUS) AS LONG

'============================<[ Globals ]>=============================
Global ghWinHand as Dword                       'Handle of main dialog.
Global gsServiceName as String                  'Service name
Global gsServiceDisplayName as String           'Service display name
Global glQuietRequest as Long                   'The value following the /Q or -Q parm
                                                ' &H01= Install
                                                ' &H02= Start
                                                ' &H04= Stop
                                                ' &H08= Uninstall
                                                ' &H10= Reload Config
Global ghA as Dword
Global gsA as String

'=========================<[ Auxiliary Ruts ]>=========================
' ==========>>> Customize Message Box
Function arCustomizeMessageBoxRut(byval rlMsg as Long, byval wlParam as Long, byval rlParam as Long) as Long

   if rlMsg = %HCBT_ACTIVATE then

      ' Set buttons
      if len(gsA) then
         select case long parsecount(gsA, $BS)
         case 3
            control set text wlParam, %MB_IDAbort, parse$(gsA, $BS, 1)
            control set text wlParam, %MB_IDRetry, parse$(gsA, $BS, 2)
            control set text wlParam, %MB_IDIgnore, parse$(gsA, $BS, 3)
         case 2
            control set text wlParam, %MB_IDYes, parse$(gsA, $BS, 1)
            control set text wlParam, %MB_IDNo, parse$(gsA, $BS, 2)
         case 1
            control set text wlParam, %MB_IDOK, parse$(gsA, $BS, 1)
         end select
      end if

      ' Unhook
      UnhookWindowsHookEx ghA

   end if

End Function

' ==========>>> Message Box
Function arMsgBox(rsMsg as String, rsModChars as String, optional byval rsButtonNames as String)Export as Long
'   ModChars as follows:
'                  Icons are upper case
'      I = Information Icon
'      W = Warning or Exclamation Icon
'      E = Error or Stop Icon
'      Q = Questions Icon
'                  Buttons are lower case or numeric
'      y = Yes and No
'      u = Yes, No and Cancel
'      c = OK and Cancel
'      r = Retry and Cancel
'      a = Abort, Retry and Ignore
'      t = Cancel, Try Again, Continue
'      2 = Button 2 is default
'      3 = Button 3 is default

   Local llMods as Long

   ' Build mods
   if instr(rsModChars, "I") then llMods = llMods or %MB_IconInformation
   if instr(rsModChars, "W") then llMods = llMods or %MB_IconExclamation
   if instr(rsModChars, "E") then llMods = llMods or %MB_IconStop
   if instr(rsModChars, "Q") then llMods = llMods or %MB_IconQuestion
   if instr(rsModChars, "y") then llMods = llMods or %MB_YesNo
   if instr(rsModChars, "u") then llMods = llMods or %MB_YesNoCancel
   if instr(rsModChars, "c") then llMods = llMods or %MB_OKCancel
   if instr(rsModChars, "a") then llMods = llMods or %MB_AbortRetryIgnore
   if instr(rsModChars, "r") then llMods = llMods or %MB_RetryCancel
   if instr(rsModChars, "t") then llMods = llMods or %MB_CancelTryContinue
   if instr(rsModChars, "2") then llMods = llMods or %MB_DefButton2
   if instr(rsModChars, "3") then llMods = llMods or %MB_DefButton3

   ' Set global button names
   gsA = rsButtonNames

   ' Set hook
   ghA = SetWindowsHookEx(%WH_CBT, codeptr(arCustomizeMessageBoxRut), GetModuleHandle(""), GetCurrentThreadID)

   ' Pop message if not quiet
   if isfalse glQuietRequest then function = MessageBox(0, bycopy rsMsg, "Admin of " & gsServiceDisplayName, llMods)

End Function

' ==========>>> Get Ini
Function arGetIni(rsFile as Asciiz, rsSection as Asciiz, rsEntity as Asciiz, wsData as String) as Long

   Local llLen as Long
   Local lzpData as Asciz ptr

   ' Init stuff
   wsData = space$(16384)  ' starting size

   ' Get it
   do
   lzpData = strptr(wsData)
      llLen = GetPrivateProfileString(rsSection, rsEntity, $CRLF, @lzpData, len(wsData), rsFile)
      if llLen < len(wsData) - 2  then
         ' If returning data is just the defauld $CRLF then it wasn't found
         if left$(wsData, 2) = $CRLF then
            ReturnNotFound:
            reset wsData
            function = -17
         else
            wsData = rtrim$(left$(wsData, llLen), $NUL)
         end if
         exit do
      end if
      wsData = space$(len(wsData) + 1638400)  ' next size
      ' If for some reason the data is larger than max then .....
      if isfalse len(wsData) then goto ReturnNotFound
   loop

End Function

'=======================<[ Get Service Status ]>=======================
Function GetServiceStatus () as Long
'   Returns one of the following:
'      1 = Stopped
'      2 = Starting
'      3 = Stopping
'      4 = Running
'      5 = Continuing
'      6 = Pausing
'      7 = Paused
'     91 = Not Installed
'    901 = Can't open SCManager
'    902 = Can't query service
'    903 = Exit Admin

   Local llA as Long
   Local lhManager as Dword
   Local lhService as Dword
   Local lsA as String
   Local lzServiceName as Asciiz * 255
   Local luStatus as SERVICE_STATUS
   Local luConfig as QueryServiceConfig_TYPE

   ' Init stuff
   lzServiceName = gsServiceName

   ' Open manager
   lhManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CONNECT)
   if isfalse lhManager then function = 901 : goto CloseHandles

   ' Open service
   lhService = OpenService(lhManager, lzServiceName, %SERVICE_ALL_ACCESS)
   if isfalse lhService then function = 91 : goto CloseHandles

   ' Query service
   if isfalse QueryServiceStatus(lhService, luStatus) then function = 902 : goto CloseHandles

   ' If service is running or stopped then check if this is really our service
   if luStatus.dwCurrentState = 1 or luStatus.dwCurrentState = 4 then

      if isfalse QueryServiceConfig(lhService, luConfig, sizeof(luConfig), 0) then function = 902 : goto CloseHandles

      ' Check the fully pathed program name and display name
      if luConfig.@lpBinaryPathName <> curdir$ & "\" & $ServiceProgramAndParm or _
         luConfig.@lpDisplayName <> gsServiceDisplayName then

         ' We have a problem Houston
         lsA = "The installed service """ & gsServiceName & """ has a different pathed program or display name. What it is and what it shoud be follows:" & string$(2, $CR) & _
               "Pathed Program IS:   " & luConfig.@lpBinaryPathName & $CR & _
               "Pathed Program SB:  " & curdir$ & "\" & $ServiceProgramAndParm & string$(2, $CR) & _
               "Display Name IS:   " & luConfig.@lpDisplayName & $CR & _
               "Display Name SB:  " & gsServiceDisplayName & string$(2, $CR)

         ' Diffetent options if running vs stopped
         if luStatus.dwCurrentState = 4 then
            arMsgBox lsA & "The service is currently running so you may continue and stop it at the next message.", "W"
         else
            if arMsgBox(lsA & "The service is currently stopped.  You can uninstall it or just exit admin.", "Wy2", "UninstallExit") = %MB_IDYes then
               call UninstallService to llA
               if llA then
                  arMsgBox "SQLitening server was uninstalled.", "I"
               else
                  arMsgBox "SQLitening server failed to uninstall.", "E"
               end if
            end if
            function = 903 : goto CloseHandles
         end if
      end if
   end if

   ' Return status
   function = luStatus.dwCurrentState

   ' Close handles
   CloseHandles:
   CloseServiceHandle lhService
   CloseServiceHandle lhManager

End Function

'========================<[ Install Service ]>=========================
Function InstallService as Long

   Local lhManager as Dword
   Local lhService as Dword
   Local lzServiceName as Asciiz * 255
   Local lzDisplayName as Asciiz * 255
   Local lzExeName as Asciiz * 1024

   ' Open manager
   lhManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CREATE_SERVICE)
   if isfalse lhManager then goto CloseHandles

   ' Install the service.
   lzServiceName = gsServiceName
   lzDisplayName = gsServiceDisplayName
   lzExeName = curdir$ & "\" & $ServiceProgramAndParm
   lhService = CreateService(lhManager, lzServiceName, lzDisplayName, _
                              %SERVICE_ALL_ACCESS, %SERVICE_WIN32_OWN_PROCESS, _
                              %SERVICE_AUTO_START, %SERVICE_ERROR_NORMAL, _
                              lzExeName, _
                              ByVal %NULL, ByVal %NULL, _
                              ByVal %NULL, ByVal %NULL, ByVal %NULL)
   if isfalse lhService then goto CloseHandles
   function = %True

   ' Close handles
   CloseHandles:
   CloseServiceHandle lhService
   CloseServiceHandle lhManager

End Function

'===================<[ Send Recieve Admin Message ]>===================
Function SendReceiveAdminMessage(byval rlRequest as Long, _
                                 rsSendMessage as String, _
                                 wsReceiveMessage as String) as Long

   Local llA, llB as Long
   Local llFileNumber as Long
   local lsA as String
   Local lsDataIn as String
   Dim lsaDataIn(0 to 4) as String

   ' Get the port from the .Cfg file. If none there then
   ' will use default of 51234
'   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "Port", lsA
   arGetIni CurDir$ & "\slSQLServer.cfg", "General", "Port", lsA
   If IsFalse Len(lsA) Or UCase$(lsA) = "DEFAULT" Then
      lsA = "51234"
   else
      if verify(lsA, "0123456789") then lsA = "Invalid Port" : goto ErrorOccured
   end if
   llA = val(lsA)

   ' Get the Hosts from the .Cfg file.  This program can
   ' be set to be multi-homed - that is,
   ' listen on more than one IP address (host).
'   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "Hosts", lsA
   arGetIni CurDir$ & "\slSQLServer.Cfg", "General", "Hosts", lsA
   If IsFalse Len(lsA) Then lsA = "No Hosts in .Cfg file." : GoTo ErrorOccured

   ' Connect
   llFileNumber = freefile
   tcp open port llA at parse$(lsA, 1) as llFileNumber timeout 1000
   if err then lsA = "Couldn't connect." : goto ErrorOccured

   '  Data to server will be fromatted as follows
   '      1 -  4  =  Total DataOut lenght as Dword
   '      5 -  5  =  Flags as Byte, 1 = Bytes 16 and byound are compressed.
   '      6 -  7  =  Request code as Integer --- Always %reqAdmin
   '      8 - 11  =  Value 1. Database or Set handle or other numeric value as Dword
   '                          Request as follows:   1 = Refresh, 2  = List, 3 = Kill
   '     12 - 15  =  Value 2. Column number or other numeric value as Dword
   '     16 -  ?  =  Data. Format depends on request.

   tcp send llFileNumber, mkdwd$(15 + len(rsSendMessage)) & mkbyt$(0) & mki$(%reqAdmin) & mkdwd$(rlRequest) & mkdwd$(0) & rsSendMessage
   if err then lsA = "Couldn't send." : goto ErrorOccured

   ' Data from server will be fromatted as follows
   '      1 -  4  =  Total DataIn lenght as Dword
   '      5 -  5  =  Flags as Byte, 1 = Bytes 12 and byound are compressed.
   '      6 -  7  =  Return code as Integer normally from the SQLite engine.
   '      8 - 11  =  Value 1 as Dword.
   '     12 -  ?  =  Data. Format depends on request.

   ' Receive first chunk of data
   do
      sleep 15
      tcp recv llFileNumber, 1024 * 32, lsaDataIn(0)
   loop while isfalse len(lsaDataIn(0)) and isfalse err and isfalse eof(llFileNumber)

   ' Receive any remaining chunks
   llA = cvdwd(lsaDataIn(0))
   if len(lsaDataIn(0)) < llA then

      ' There is more data
      llA = llA - len(lsaDataIn(0))
      do
         incr llB
         if llB > ubound(lsaDataIn) then redim preserve lsaDataIn(0 to llB + 5)
         tcp recv llFileNumber, llA, lsaDataIn(llB)
         llA = llA - len(lsaDataIn(llB))
      loop while llA > 0 and len(lsaDataIn(llB))
      if llA <> 0 then lsA = "Received wrong length." : goto ErrorOccured

   elseif isfalse llA then

      ' There was no data in message so we have a problem Houston.
      lsA = "Received nothing." : goto ErrorOccured

   end if
   if err then lsA = "Couldn't receive. Err=" & error$ : goto ErrorOccured       ' Could not recieve request  Probably not connected
   lsDataIn = join$(lsaDataIn(), "")

   ' Build returning stuff, uncompressing if needed
   if cvbyt(lsDataIn, 5) = 1 then
      ' Uncompress it
      lsA = space$(cvdwd(lsDataIn, 6))
      ZLibUnCompress byval strptr(lsA), len(lsA), byval strptr(lsDataIn) + 9, len(lsDataIn) - 9
      function = cvi(lsA, 1)
      wsReceiveMessage = mid$(lsA, 7)
   else
      function = cvi(lsDataIn, 6)
      wsReceiveMessage = mid$(lsDataIn, 12)
   end if

   ' Exit
   exit function

   ErrorOccured:
   arMsgBox lsA, "E"
   function = -666

End Function

'============================<[ Run Tool ]>============================
Sub RunTool

   Local llDo as Long
   Local llA as Long
   Local lsA, lsB as String

   ' Determine which tool
   control get check ghWinHand, %rbRefreshConfig to llA
   if llA then

      ' Refresh config
      if isfalse SendReceiveAdminMessage(1, "", "") then arMsgBox "The Config Data and FACT have been refreshed.", "I"

   else
      control get check ghWinHand, %rbListConnections to llA
      if llA then

         ' List connections
         if isfalse SendReceiveAdminMessage(2, "", lsA) then
            if len(lsA) then
               replace $VT with $CR in lsA
               replace "," with " " in lsA
               replace $BS with ",    " in lsA
               lsA = "TCP File Number,   User,   Computer,   IP Address,   Date-Time Connected" & $CR & $CR & lsA
            else
               lsA = "There are no active connections."
            end if
            msgbox lsA, 0, "Active Connections"
         end if

      else
         control get check ghWinHand, %rbKillConnection to llA
         if llA then

            ' Kill connection
         lsA = inputbox$("Enter the TCP File Number of the connection you want to kill.", "Kill Connection")
         if len(lsA) and val(lsA) then

            ' Audit TCP File Number
            if SendReceiveAdminMessage(2, "", lsB) = 0 then
               for llDo = 1 to parsecount(lsB, $VT)
                  if val(lsA) = val(parse$(parse$(lsB, $VT, llDo), $BS, 1)) then
                     llA = SendReceiveAdminMessage(3, mkdwd$(val(lsA)), "")
                     arMsgBox "Posted request to kill TCP File Number " & format$(val(lsA)) & ".  May take up to 60 seconds." & _
                              iif$(llA = 1, $CR & $CR & "There was a kill pending, it was cancelled!", ""), "I"
                     exit for
                  end if
               next
               if llDo > parsecount(lsB, $VT) then arMsgBox "TCP File Number " & format$(val(lsa)) & " is not active.", "W"
            end if

         end if

         end if
      end if
   end if

End Sub

'=========================<[ Start Service ]>==========================
Function StartService as Long

   Local llDo as Long
   Local llA as Long
   Local lhManager as Dword
   Local lhService as Dword
   Local lzServiceName as Asciiz * 255
   Local lsA as String

   ' Create Temp folder if not there and make sure we can open file in it
   errclear
   llA = getattr("Temp")
   if err then
      errclear
      mkdir "Temp"
      if err then
         arMsgBox "Unable to create the Temp folder.  Error=" & error$, "E"
         exit function
      end if
   end if
   open "Temp\Test" for binary as #1
   if err then
      arMsgBox "Unable to open Test file in the Temp folder.  Error=" & error$, "E"
      exit function
   end if
   close #1
   lsA = dir$("Temp\*")
   do while len(lsA)
      kill "Temp\" & lsA
      if err then
         arMsgBox "Unable to delete file in the Temp folder.  Error=" & error$, "E"
         exit function
      end if
      lsA = dir$
   loop

   ' Open manager
   lhManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CREATE_SERVICE)
   if isfalse lhManager then goto CloseHandles

   ' Open service
   lzServiceName = gsServiceName
   lhService = OpenService(lhManager, lzServiceName, %SERVICE_ALL_ACCESS)
   if isfalse lhService then goto CloseHandles

   ' Start service
   if isfalse StartServiceA(lhService, 0, %Null) then goto CloseHandles

   ' Loop until it's starting
   for llDo = 1 to 1000
      select case long GetServiceStatus
      case 1   'stopped
      case 2   'starting
         exit for
      case else
         arMsgBox "SQLitening server is in an invalid status.", "E"
         exit for
      end select
      sleep 10
   next

   ' Loop untill it starts or fails
   do
      select case long GetServiceStatus
      case 1   'stopped
         goto CloseHandles
      case 2   'starting
      case 3   'stopping
      case 4   'running
         function = %True
         exit do
      case else
         arMsgBox "SQLitening server is in an invalid status.", "E"
         exit do
      end select
      sleep 10
   loop

   ' Close handles
   CloseHandles:
   CloseServiceHandle lhService
   CloseServiceHandle lhManager

End Function

'=========================<[ Stop Service ]>==========================
Function StopService as Long

   Local lhManager as Dword
   Local lhService as Dword
   Local lzServiceName as Asciiz * 255
   Local luStatus as Service_Status
   Local lsA as String

   ' Open manager
   lhManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CREATE_SERVICE)
   if isfalse lhManager then goto CloseHandles

   ' Open service
   lzServiceName = gsServiceName
   lhService = OpenService(lhManager, lzServiceName, %SERVICE_ALL_ACCESS)
   if isfalse lhService then goto CloseHandles

   ' Stop service
   if ControlService(lhService, %SERVICE_CONTROL_STOP, luStatus) then function = %True

   ' Kill Temp folder
   lsA = dir$("Temp\*")
   do while len(lsA)
      kill "Temp\" & lsA
      lsA = dir$
   loop
   errclear
   rmdir "Temp"
   if err then arMsgBox "Unable to delete the Temp folder.  Error=" & error$, "W"

   ' Close handles
   CloseHandles:
   CloseServiceHandle lhService
   CloseServiceHandle lhManager

End Function

'=======================<[ Uninstall Service ]>========================
Function UninstallService as Long

   Local lhManager as Dword
   Local lhService as Dword
   Local lzServiceName as Asciiz * 255

   ' Open manager
   lhManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CREATE_SERVICE)
   if isfalse lhManager then goto CloseHandles

   ' Open service
   lzServiceName = gsServiceName
   lhService = OpenService(lhManager, lzServiceName, %SERVICE_ALL_ACCESS)
   if isfalse lhService then goto CloseHandles

   ' Delete service
   if DeleteService(lhService) then function = %True

   ' Close handles
   CloseHandles:
   CloseServiceHandle lhService
   CloseServiceHandle lhManager

End Function

'===========================<[ Dispatcher ]>===========================
CallBack Function DispatcherMain()

   select case long cbMsg
   case %WM_Command
      select case long cb.Ctl
      case %butExit
         dialog end cb.Hndl
      case %butRun
         RunTool
      end select
   case %WM_Destroy
   end select

End Function

'============================<[ Builder ]>=============================
' ==========>>> Main
Sub BuildTools(byval hParent As Dword)

   Dialog New hParent, "Admin Tools for " & gsServiceDisplayName, 82, 66, 250, 120, %WS_POPUP Or %WS_BORDER Or %WS_DLGFRAME Or _
   %WS_SYSMENU Or %WS_CLIPSIBLINGS Or %WS_VISIBLE Or %DS_CENTER Or %DS_3DLOOK Or _
   %DS_NOFAILCREATE Or %DS_SETFONT, %WS_EX_WINDOWEDGE Or %WS_EX_CONTROLPARENT Or _
   %WS_EX_TOOLWINDOW Or %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR, To ghWinHand
   Control Add Option,   ghWinHand, %rbRefreshConfig, "Refresh the Config Data and FACT", 40, 10, 200, 12, %WS_CHILD Or %WS_VISIBLE Or _
      %WS_GROUP Or %WS_TABSTOP Or %BS_TEXT Or %BS_AUTORADIOBUTTON Or %BS_LEFT Or %BS_VCENTER, _
      %WS_EX_LEFT Or %WS_EX_LTRREADING
   Control Add Option,   ghWinHand, %rbListConnections, "List all Active Connectons", 40, 30, 200, 12, %WS_CHILD Or %WS_VISIBLE Or _
      %BS_TEXT Or %BS_AUTORADIOBUTTON Or %BS_NOTIFY Or %BS_LEFT Or %BS_VCENTER, %WS_EX_LEFT Or _
      %WS_EX_LTRREADING
   Control Add Option,   ghWinHand, %rbKillConnection, "Kill one Active Connection", 40, 50, 200, 12, %WS_CHILD Or %WS_VISIBLE Or _
      %BS_TEXT Or %BS_AUTORADIOBUTTON Or %BS_LEFT Or %BS_VCENTER, %WS_EX_LEFT Or _
      %WS_EX_LTRREADING
   Control Add Button,   ghWinHand, %butRun, "&Run", 138, 104, 50, 15
   Control Add Button,   ghWinHand, %butExit, "&Exit", 196, 104, 50, 15
   Dialog  Send          ghWinHand, %DM_SETDEFID, %butRun, 0
   control set option ghWinHand, %rbRefreshConfig, %rbRefreshConfig, %rbKillConnection
   Dialog Show Modal ghWinHand, Call DispatcherMain

End Sub

'============================<[ Do Admin ]>============================
Sub DoAdmin

   ' Get Status
   select case long GetServiceStatus
   case 1
      select case long arMsgBox("SQLitening server is stopped.  You can start it, uninstall it, or just exit Admin.", "Qa3", "StartUninstallExit")
      case %MB_IDAbort     ' start
         if StartService then
            arMsgBox "SQLitening server was started.", "I"
         else
            arMsgBox "SQLitening server failed to start. There may have been a preceding error message.  " & _
                     "Check Log file.  If nothing in Log file then error occurred before server program could start (missing required DLL?) or you lack required privileges.  Try starting from control panel.", "E"
         end if
      case %MB_IDRetry     ' uninstall
         if UninstallService then
            arMsgBox "SQLitening server was uninstalled.", "I"
         else
            arMsgBox "SQLitening server failed to uninstall.", "E"
         end if
      end select
   case 2
      arMsgBox "SQLitening server is currently starting.  Try again later after it's running.", "W"
   case 3
      arMsgBox "SQLitening server is currently stopping.  Try again later after it's stopped.", "W"
   case 4
      select case long arMsgBox("SQLitening server is running.  You can stop it, run tools, or just exit Admin.", "Qa3", "StopToolsExit")
      case %MB_IDAbort     ' stop
         if StopService then
            arMsgBox "SQLitening server was stopped.", "I"
            DoAdmin
         else
            arMsgBox "SQLitening server failed to stop. Check Log file.", "E"
         end if
      case %MB_IDRetry     ' tools
         BuildTools %HWND_DESKTOP
      end select
   case 91
      if arMsgBox("SQLitening server is not installed.  You can install it or just exit Admin.", "Qy2", "InstallExit") = %MB_IDYes then
         if InstallService then
            arMsgBox "SQLitening server was installed.", "I"
            DoAdmin
         else
            arMsgBox "SQLitening server failed to install.", "E"
         end if
      end if
   case 5, 6, 7
      arMsgBox "SQLitening server is currently continuing, pausing, or paused.  This is an invalid status.", "E"
   case 901
      arMsgBox "Admin can't open the Services Control Manager.  This is an invalid status.", "E"
   case 902
      arMsgBox "Admin can't query the Services Control Manager.  This is an invalid status.", "E"
   case 903
   case else
      arMsgBox "SQLitening server is in an unknown/invalid status.", "E"
   end select

End Sub

'=========================<[ Do Admin Quiet ]>=========================
Function DoAdminQuiet as Long
   ' QuietRequest value following the /Q or -Q parm
   '     &H01= Install
   '     &H02= Start
   '     &H04= Stop
   '     &H08= Uninstall
   '     &H10= Reload Config
   ' Return Codes
   '     0 = All OK
   '     1 = Can't perform request, service in wrong status
   '     2 = Request failed.
   '     9 = Service in unknow or invalid status

   ' Get Status
   select case long GetServiceStatus
   case 1            ' Stopped
      select case long glQuietRequest
      case 2         ' Start
         if isfalse StartService then function = 2
      case 8         ' Uninstall
         if isfalse UninstallService then function = 2
      case else
         function = 1
      end select
   case 2, 3         ' Starting or Stopping
      function = 1
   case 4            ' Running
      select case long glQuietRequest
      case 4         ' Stop
         if isfalse StopService then function = 2
      case 8         ' Uninstall
         if isfalse StopService then function = 2
         if isfalse UninstallService then function = 2
      case 16        ' Reload config
         if SendReceiveAdminMessage(1, "", "") then function = 2
      case else
         function = 1
      end select
   case 91           ' Not installed
      select case long glQuietRequest
      case 1         ' Install
         if isfalse InstallService then function = 2
      case 2         ' Start
         if isfalse InstallService then function = 2
         if isfalse StartService then function = 2
      case else
         function = 1
      end select
   case 5, 6, 7      ' Continuing, Pusing, or Paused
      function = 1
   case else         ' Unknow or invalid status
      function = 9
   end select

End Function

'=============================<[ Mainer ]>=============================
Function PBMain As Long

   Local llA as Long
   Local lsA as String

   ' Set current folder
   chdir  exe.path$

   ' Init service name
'   arGetIni curdir$ & "\SQLiteningServer.Cfg", "General", "ServiceNameSuffix", lsA
'   gsServiceName = "SQLiteningServer" & lsA
'   gsServiceDisplayName = "SQLitening Database & File Server" & IIf$(Len(lsA), " - " & lsA, "")
   arGetIni CurDir$ & "\slSQLServer.Cfg", "General", "ServiceNameSuffix", lsA
   gsServiceName = "slSQLServer" & lsA
   gsServiceDisplayName = "slSQL Database & File Server" & IIf$(Len(lsA), " - " & lsA, "")

   ' Get quiet parm  if there
   llA = instr(command$, any "-/")
   if llA and mid$(command$, llA + 1, 1) = "Q" then glQuietRequest = val(mid$(command$, llA + 2))

   ' Do Admin
   if glQuietRequest then function = DoAdminQuiet else DoAdmin

End Function

